home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / widgetMenu.tcl.z / widgetMenu.tcl
Text File  |  2002-07-08  |  3KB  |  99 lines
  1. #
  2. # This was hacked upon by <John@LoVerso.Southborough.MA.US>, 4/94.
  3. #
  4. # From: allan@piano.sta.sub.org (Allan Brighton)
  5. # Newsgroups: comp.lang.tcl
  6. # Subject: Re: How do I post a menu from a canvas item ??
  7. # Message-ID: <1895@piano.stasys.UUCP>
  8. # Date: 23 Mar 94 10:41:06 GMT
  9. #
  10. #In an article mh@awds.imsd.contel.com (Michael Hoegeman) writes:
  11. #>How do you get a menu posted from a canvas and make it behave like one
  12. #>that was posted from a menubutton and get cascades and the like to work
  13. #>properly? I'd much rather use someone else's soultion rather than slog it
  14. #>out myself.
  15. #
  16. #I've been using these routines to deal with menus in a canvas.
  17. #They are not perfect, but they work. Suggestions for improvements
  18. #are welcome.
  19. #
  20. # setup canvas bindings
  21. #
  22. # $canvas bind $tag <ButtonPress-1> "menu_post $menu $canvas %X %Y"
  23. # $canvas bind $tag <ButtonRelease-1> "menu_unpost $menu $canvas"
  24.  
  25. #
  26. # To avoid internal text tag grab problems, use these bindings
  27. #    bind $tw <ButtonPress-3> {text_menu_post %W %x %y %X %Y}
  28. #    bind $tw <Any-ButtonRelease-3> {text_menu_unpost %W}
  29. # and use a tag to determine which menu to invoke.
  30. #
  31.  
  32. proc text_menu_post {w wx wy x y} {
  33.     global tkPriv
  34.     set tags [$w tag names @$wx,$wy]
  35.     Exmh_Debug $tags
  36.     set tkPriv(textmenu) {}
  37.     foreach tag $tags {
  38.         catch {
  39.         if {[winfo class $w.$tag] == "Menu"} {
  40.             set tkPriv(textmenu) $w.$tag
  41.         }
  42.         }
  43.     }
  44.     catch {menu_post $tkPriv(textmenu) $w $x $y}
  45. }
  46. proc text_menu_unpost {w} {
  47.     global tkPriv
  48.     catch {menu_unpost $tkPriv(textmenu) $w}
  49.     catch {unset tkPriv(textmenu)}
  50. }
  51.  
  52. # post the given menu at the given position in the widget (or canvas) w
  53.  
  54. proc menu_post {menu w x y} {
  55.     global tkPriv
  56.  
  57.     $menu activate none
  58.     tk_popup $menu $x $y
  59.     set tkPriv(cursor) [$w cget -cursor]
  60.     $w config -cursor arrow
  61.     grab set $w
  62. }
  63.  
  64.  
  65. # unpost the given menu in the widget
  66.  
  67. proc menu_unpost {menu w} {
  68.     global tkPriv
  69.  
  70.     tkMenuUnpost $menu
  71.     catch {$w config -cursor $tkPriv(cursor)}
  72.     grab release $w
  73. }
  74.  
  75.  
  76. # invoke the selected item in the menu, if any
  77.  
  78. proc menu_invoke {menu w} {
  79.     set i [$menu index active]
  80.     menu_unpost $menu $w
  81.     if {$i != "none"} {
  82.     $menu invoke $i
  83.     }
  84. }
  85.  
  86.  
  87. # setup the bindings for a local widget menu
  88.  
  89. proc menu_bind {menu w} {
  90.     bindtags $menu $menu
  91.     bind $menu <Any-ButtonPress> {}
  92.     bind $menu <Any-ButtonRelease> "menu_invoke $menu $w"
  93.     bind $menu <2> { }
  94.     bind $menu <B2-Motion> { }
  95.     bind $menu <Any-Motion> {%W activate @%y}
  96.     bind $menu <Any-Enter> {%W activate @%y}
  97.     bind $menu <Any-Leave> {%W activate none}
  98. }
  99.